' ****** START INCLUDE PUTSTRING(x%, y%, s$) ******
SUB PUTSTRING(x%, y%, s$)
  FOR c = 1 TO LEN(s$)
    sc$ = MID$(s$, c, 1)
    this$ = _GETCHR$(ASC(sc$))
    FOR yi = 0 TO 7
      FOR xi = 0 TO 7
        x_pset% = x% + xi + (c-1)*8 : y_pset% = y% + yi
        IF MID$(this$, (xi + yi*8) + 1, 1) = "X" AND BETWEEN(x_pset%, 0, _WIDTH-1) AND BETWEEN(y_pset%, 0, _HEIGHT-1)  THEN PSET (x_pset%, y_pset%)
      NEXT xi
    NEXT yi
  NEXT c
END SUB
'  ****** END INCLUDE PUTSTRING(x%, y%, s$) ******

' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2023.09.17.17.11]) on 2023.10.15 at 03:47 (Coordinated Universal Time)
' BAM port and mods by Charlie Veniot
' 🪲 2023-10-15: fixed bug (circle highlighting "today" not showing up at the right place)
' Based on GW-BASIC CALENDAR program by Taung-Chao Lee and Benito Navarro Mtz
' Found at https://www.facebook.com/groups/2057165187928233/permalink/3495093077468763/

DECLARE FUNCTION ValidAction%()

110 SCREEN _newimage(260,144,0): COLOR 14 :CLS

150 MON=0 : YEAR=0
160 DIM A$(12), A(42)
170 DATA January, February, March, April, May, June
180 DATA July, August, September, October, November
190 DATA December
200 FOR I=1 TO 12:READ A$(I):NEXT

Y = VAL(RIGHT$(DATE$, 4))
M = VAL(LEFT$(DATE$, 2))

ShowCalendar📆:

    CLS
    N=0
    D=0 : LEAP=0
    FOR I=0 TO 41 : A(I) = 99 : NEXT I

    230 MON=M:YEAR=Y:L=31
    240 IF M=4 OR M=6 OR M=9 OR M=11 THEN L=30
    250 IF M=2 THEN L=28
    260 IF Y/4=INT(Y/4) AND Y/100<>INT(Y/100) THEN LEAP=1
    270 IF Y/400=INT(Y/400) THEN LEAP=1
    280 IF M=2 AND LEAP=1 THEN L=29
    290 IF M<3 THEN M=M+12:Y=Y-1
    300 N=(3+Y+2*M+INT((3*M+3)/5)+INT(Y/4)-INT(Y/100)+INT(Y/400)) MOD 7
    310 IF N=0 THEN N=7
    320 FOR I=N TO 42:D=D+1:A(I)=D:NEXT
    ' 330 CLS
    ' 335 'COLOR 3
    350 LOCATE 2:PRINT spc(14-LEN(A$(MON))/2);A$(MON);" ";YEAR
    GOSUB ShowNavButtons🧭
    360 PRINT
    370 PRINT SPC(3);"Sun Mon Tue Wed Thu Fri Sat"
    380 PRINT
    today_x = -1
    today_y = -1
    390 FOR I=0 TO 5
        PRINT SPC(1);
        400   FOR J=1+I*7 TO 7+I*7
        410     IF A(J)=0 OR A(J)>L THEN 430
        FirstDaySpc% = IFF(I=0 AND A(J) = 1 AND J > 1,(J-1)*4,0)
        420     PRINT spc(2+FirstDaySpc%);: PRINT USING "##";A(J);
        IF A(J) = VAL(MID$(DATE$,4,2)) AND MON = VAL(LEFT$(DATE$,2)) AND YEAR = VAL(RIGHT$(DATE$,4)) _
           THEN today_x = (pos(0)-2)*8 : today_y = CSRLIN*(8)-4
        430   NEXT
        440   PRINT:PRINT
    450 NEXT I
    IF today_x <> - 1 THEN circle (today_x,today_y), 16, 11 
    460 LINE (4,2)-(254,141),11,B
    PAINT (0,0), 3,11

    DO : LOOP UNTIL ValidAction%() = TRUE 
    GOTO ShowCalendar📆

END

ShowNavButtons🧭: 
    ' Previous/Next Month buttons
    COLOR 15
    PUTSTRING(17,8,"<")      : PUTSTRING(xMAX-25,8,">")
    LINE (17-2,8) - (17+8,16)B : LINE (xMAX-25-2,8) - (xMAX-25+8,16)B
    COLOR 14
RETURN

FUNCTION ValidAction%()
    DIM Return% = FALSE
    IF _MOUSEBUTTON THEN
        IF _MOUSEZONE(17-2,9,12,9) OR _MOUSEZONE(xMAX-25-2,9,12,9) THEN
            WHILE _MOUSEBUTTON : WEND
            IF _MOUSEZONE(17-2,9,12,9) THEN M = IFF(MON=1,13,MON) - 1 : Y = YEAR - IFF(M=12,1,0) : Return% = TRUE
            IF _MOUSEZONE(xMAX-25-2,9,12,9) THEN M = IFF(MON=12,0,MON) + 1 : Y = YEAR + IFF(M=1,1,0) : Return% = TRUE
        END IF
    END IF
ValidAction% = Return% : END FUNCTION